Import data

df_coop_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/coop_ratio/*.csv"), read_csv))
df_coop_max <- do.call(rbind, lapply(Sys.glob("../*max/data/coop_ratio/*.csv"), read_csv))
df_coop_min <- do.call(rbind, lapply(Sys.glob("../*min/data/coop_ratio/*.csv"), read_csv))
full <- df_coop_homo %>%
  rbind(df_coop_max) %>%
  rbind(df_coop_min)
rm(df_coop_homo,df_coop_max,df_coop_min)

Cooperation Ratio

Analysis of cooperation ratio

full %>%
  group_by(tournament_type, seed) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  ggplot(aes(x = as.factor(tournament_type), y = mean_coop, fill = tournament_type)) +
  geom_bar(stat="identity") +
  geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
  facet_wrap(~seed) +
  coord_flip() +
  scale_fill_grey(guide = F) +
  labs(title = "Mean cooperation ratio and standard deviation per tournament type, facetted by seed",
       y = "cooperatio ratio",
       x = " ")

full %>%
  group_by(tournament_type, seed) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  ggplot(aes(x = as.factor(seed), y = mean_coop, fill = tournament_type)) +
    geom_bar(stat="identity") +
    geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
    facet_wrap(~tournament_type) +
    coord_flip() +
    scale_fill_grey(guide = F) +
    labs(title = "Mean cooperation ratio and standard deviation per seed, facetted by tournament type",
         y = "cooperatio ratio",
         x = " ")

full %>%
  group_by(tournament_type) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  arrange(desc(mean_coop)) %>%
  kable(caption = "Tournament types arranged by mean of cooperation ratio") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by mean of cooperation ratio
tournament_type mean_coop sd_coop
hetero_dr_sd_max 0.6002804 0.1605549
homogenous 0.5892130 0.1542594
pareto_m_max 0.5886649 0.1566004
hetero_m_sd_max 0.5859083 0.1568820
pareto_mdr_max 0.5825757 0.1616499
hetero_mdr_sd_max 0.5817933 0.1660426
hetero_m_sd_min 0.5799698 0.1605414
pareto_dr_max 0.5795952 0.1543603
hetero_mdr_sd_min 0.5793128 0.1596192
hetero_dr_sd_min 0.5789166 0.1612046
pareto_m_min 0.5747713 0.1575829
pareto_mdr_min 0.5715410 0.1618162
pareto_dr_min 0.5713618 0.1638552 
full %>%
  group_by(tournament_type) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  arrange(desc(sd_coop)) %>%
  kable(caption = "Tournament types arranged by s.d. of cooperation ratio") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by s.d. of cooperation ratio
tournament_type mean_coop sd_coop
hetero_mdr_sd_max 0.5817933 0.1660426
pareto_dr_min 0.5713618 0.1638552
pareto_mdr_min 0.5715410 0.1618162
pareto_mdr_max 0.5825757 0.1616499
hetero_dr_sd_min 0.5789166 0.1612046
hetero_dr_sd_max 0.6002804 0.1605549
hetero_m_sd_min 0.5799698 0.1605414
hetero_mdr_sd_min 0.5793128 0.1596192
pareto_m_min 0.5747713 0.1575829
hetero_m_sd_max 0.5859083 0.1568820
pareto_m_max 0.5886649 0.1566004
pareto_dr_max 0.5795952 0.1543603
homogenous 0.5892130 0.1542594

Comparing the control group with heterogenous groups__

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_dr_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_m_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_mdr_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_dr_sd_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_m_sd_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_mdr_sd_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_dr_sd_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_m_sd_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_mdr_sd_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_dr_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_m_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_mdr_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F)

Stability

Data Prep

Data import

Comparison of All Groups

my_formula <- y ~ x

df_outliers_full %>%
  ggplot() +
  geom_point(aes(S.D., Counts, color = as.factor(seed))) +
  geom_smooth(aes(S.D., Counts), color = "black") +
  facet_wrap(~tournament_type) +
      scale_color_grey(guide = F) +
  labs(title = "Smooth function applied to count of outliers on standard deviation",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  filter(S.D. <= 1.5) %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Range of S.D. limited from 0 to 1.5",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  filter(S.D. >= 1.5) %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Range of S.D. limited from 1.5 to 3",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Intercept)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
pareto_dr_max 318.9619 -124.5255 0.9151360
control_group 313.9496 -121.9624 0.9149856
pareto_m_max 309.6571 -120.7227 0.9116794
norm_m_sd_max 305.0884 -118.9032 0.9102347
norm_mdr_sd_min 304.7535 -119.0130 0.9043898
pareto_mdr_min 300.6716 -117.2629 0.9114020
pareto_m_min 299.2762 -116.3644 0.9159300
norm_dr_sd_min 295.8781 -115.0315 0.9208328
pareto_dr_min 295.6928 -115.4574 0.9107716
norm_m_sd_min 294.6364 -114.5549 0.9221166
pareto_mdr_max 293.8838 -114.2017 0.9117865
norm_dr_sd_max 293.4010 -114.0533 0.9138033
norm_mdr_sd_max 290.0874 -112.9884 0.9226192 
df_outliers_full %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Slope)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
norm_mdr_sd_max 290.0874 -112.9884 0.9226192
norm_dr_sd_max 293.4010 -114.0533 0.9138033
pareto_mdr_max 293.8838 -114.2017 0.9117865
norm_m_sd_min 294.6364 -114.5549 0.9221166
norm_dr_sd_min 295.8781 -115.0315 0.9208328
pareto_dr_min 295.6928 -115.4574 0.9107716
pareto_m_min 299.2762 -116.3644 0.9159300
pareto_mdr_min 300.6716 -117.2629 0.9114020
norm_m_sd_max 305.0884 -118.9032 0.9102347
norm_mdr_sd_min 304.7535 -119.0130 0.9043898
pareto_m_max 309.6571 -120.7227 0.9116794
control_group 313.9496 -121.9624 0.9149856
pareto_dr_max 318.9619 -124.5255 0.9151360 
df_outliers_full %>%
  filter(S.D. >= 1.5) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Intercept)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
control_group 193.8478 -71.48235 0.7876658
pareto_dr_max 186.0338 -68.77059 0.8088354
norm_dr_sd_min 185.9125 -68.92500 0.8334723
pareto_m_max 185.5368 -68.61912 0.8044666
norm_m_sd_min 185.2934 -68.67206 0.8164341
norm_mdr_sd_max 181.2279 -67.39853 0.7971754
pareto_mdr_max 178.9463 -65.77059 0.8186737
pareto_mdr_min 178.7713 -66.17059 0.8256462
norm_dr_sd_max 176.3926 -65.04118 0.8046657
norm_m_sd_max 172.1493 -63.04412 0.8244890
pareto_m_min 171.8176 -62.84118 0.8271148
pareto_dr_min 171.7963 -63.37059 0.8370174
norm_mdr_sd_min 170.6169 -62.63529 0.7871810 
df_outliers_full %>%
  filter(S.D. >= 1.5) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Slope)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
norm_mdr_sd_min 170.6169 -62.63529 0.7871810
pareto_m_min 171.8176 -62.84118 0.8271148
norm_m_sd_max 172.1493 -63.04412 0.8244890
pareto_dr_min 171.7963 -63.37059 0.8370174
norm_dr_sd_max 176.3926 -65.04118 0.8046657
pareto_mdr_max 178.9463 -65.77059 0.8186737
pareto_mdr_min 178.7713 -66.17059 0.8256462
norm_mdr_sd_max 181.2279 -67.39853 0.7971754
pareto_m_max 185.5368 -68.61912 0.8044666
norm_m_sd_min 185.2934 -68.67206 0.8164341
pareto_dr_max 186.0338 -68.77059 0.8088354
norm_dr_sd_min 185.9125 -68.92500 0.8334723
control_group 193.8478 -71.48235 0.7876658 
df_outliers_full %>%
  filter(S.D. <= 1.5) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Intercept)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
pareto_dr_max 374.7909 -171.6273 0.9115656
norm_mdr_sd_min 366.8455 -172.9364 0.9000166
control_group 366.7818 -166.7818 0.8821214
norm_m_sd_max 364.4545 -169.7364 0.9126566
pareto_m_max 361.1273 -163.5818 0.8732808
pareto_m_min 355.0000 -163.8364 0.9307597
pareto_dr_min 353.6909 -165.9818 0.8884670
pareto_mdr_min 350.3091 -158.7636 0.8550133
pareto_mdr_max 350.1545 -163.3909 0.8820445
norm_dr_sd_min 340.1091 -151.6727 0.8697545
norm_m_sd_min 339.6182 -151.9818 0.8952851
norm_dr_sd_max 339.1091 -151.6727 0.8704247
norm_mdr_sd_max 331.2273 -146.3182 0.9065081 
df_outliers_full %>%
  filter(S.D. <= 1.5) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Slope)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
norm_mdr_sd_max 331.2273 -146.3182 0.9065081
norm_dr_sd_max 339.1091 -151.6727 0.8704247
norm_dr_sd_min 340.1091 -151.6727 0.8697545
norm_m_sd_min 339.6182 -151.9818 0.8952851
pareto_mdr_min 350.3091 -158.7636 0.8550133
pareto_mdr_max 350.1545 -163.3909 0.8820445
pareto_m_max 361.1273 -163.5818 0.8732808
pareto_m_min 355.0000 -163.8364 0.9307597
pareto_dr_min 353.6909 -165.9818 0.8884670
control_group 366.7818 -166.7818 0.8821214
norm_m_sd_max 364.4545 -169.7364 0.9126566
pareto_dr_max 374.7909 -171.6273 0.9115656
norm_mdr_sd_min 366.8455 -172.9364 0.9000166